Aminet 1 (Walnut Creek)/Aminet - June 1993 [Walnut Creek].iso/aminet/text/print/deskjet500print.lha/a4print4.rexx

OS/2 REXX Batch file | 1992-10-09 | 12KB | 331 lines

/*
4print.rexx version 2.2

+ Script modified for papersize DIN A4 (ATN: Alley enlarged - upto 3 additional chars per line !)
+ automatic handling of twosided printjobs
+ partial translation of umlauts to the deskjet default charset PC8
+ handling of backspaces (double strike typewriter mode :-))

Customization:
-> for other paper formats, adjust localpagesize, psize,
   change the settings for the various layout styles (width, oddleftborder)
   and set the command sequence isoA4='' for default (should be US Letter)

Peter Jakobi, Munich, Oct. 2, 1992
[e-mail]
[e-mail]


let me first quote from Georg Hessmann's MakeBatch.rexx (from MetaFont): */
IF ~show('Libraries', 'rexxsupport.library') THEN DO
        IF ~addlib('rexxsupport.library', 0, -30) THEN DO
                say "No RexxSupport ... no printing"
                EXIT 10
        END
END
/*
Original Posting:

Path: informatik.tu-muenchen.de!math.fu-berlin.de!Sirius.dfn.de!chx400!ira.uka.de!yale.edu!jvnc.net!darwin.sura.net!haven.umd.edu!uunet!olivea!tardis!jms
From: [e-mail] (Joe Smith)
Newsgroups: alt.sources.amiga
Subject: Program to print 4 pages on 1 piece of paper
Summary: For HP DeskJet printer, written in AREXX
Message-ID: <[e-mail]>
Date: 2 Sep 92 07:55:40 GMT
Organization: BT Tymnet, San Jose, CA
Lines: 140
*/
/* Prints 4 pages of text on a single sheet of paper on a DeskJet 500 printer */
/* Usage: print4 filename [width]                      */
/*  where 'width' is optional, one of 89 (default), 60, 40 */

/* SOME REQUIREMENTS: SETUP MUST BE 'NO BORDERS', 'CHARSET PC8' */

parse upper arg option options

if option='?' then do
  say ''
  say '4Print.rexx [<option>*] filename'
  say 'where option is one of:'
  say '   -2           Two sided printjob'
  say '                (no manual sorting required)'
  say '   -w<number>   line width of minipage'
  say '   -D           quick draft mode instead of letter quality'
  say ''
  say 'On one sheet of paper4Print can print e.g.:'
  say '   +  8 pages à 89 chars / 66 lines'
  say '   + 16 pages à 41 chars / 66 lines'
  say ''
  say 'HP DESKJET ONLY!'
  exit 1
end

twopage=0                    /* Print on both sides ? off */
basename = 't:4print~.'
paper    = 0                    /* Outputfile and page */

/*          ' ä ü ö ß Ä Ü Ö £ ± § ­ ÷'  */
inputtable ='E4FCF6DFC4DCD6A3B1A7ADF7'x        /* Ecma94latin1 - german subset */
outputtable='848194E18E9A999CF115C4F6'x        /* Hp pc8 - _THE_DEFAULT_ for all fonts */

HT = d2c(09); LF = d2c(10); FF = d2c(12); CR = d2c(13); ESC = d2c(27)

/* localpagesize, *borders: changed for DIN A4: */
/* US should be 60, 0, 0 */

localpagesize    = 66                /* Default pagesize of the minipages */
evenleftborder   = 0

width             = 89                /* default */

draft=ESC'&k0W'ESC'*r2Q'            /* (default) uni direktional, LetterQuality */
cheap=ESC'&k1W'ESC'*r1Q'            /* bidirektional, 'draft' - might sometimes
                                                   even be slower than uni ! */

isoA4=ESC'&l26A'                /* A4 */
psize=66*2+3+2+2
psize=ESC'&l'psize'P'

do while left(option,1)='-'            /* Option parsing */
  select
    when option='-2' then twopage=1
    when option='-D' then draft=cheap        /* quick and dirty printout */
    when left(option,2)='-W'             /* Set width of minipage */
      then do
        width=substr(option,3)            /* Request twosided print */
        if datatype(width)~='NUM'
          then do
            say 'WARNING: Illegal width 'width
            width=''
            end
        end
    otherwise leave
    end
  parse var options option options
  end

infile = option                    /* input file name */

if width = '' then width = 1000            /* For numeric comparisons below */
if open('in',infile,'R')
  then if twopage then call open('out',basename||paper,'W')
                  else call open('out','par:4.tmp','W')
  else do; say "Can't open input file" infile; exit 10; end
say 'infile='infile 'width='width

select
/* 8'' PRINTABLE AREA + 1/8'' PER BORDER (HW!) -> 8.5'' DIN A4 WIDTH */
/* 24 CPI -> 192 CHARS (182 and 10.2 border) */
/* 20 CPI -> 160 CHARS (         8.4 border) */
/* Separators = º (double pipe) ù (a small circle) */

/* For US Letter, you should remove .5 inch from the width, and
   ca. 3/4 inch from the height (6 lines per minipage) */

  when width <= 44 then do    /* 24cpi 44+2+44+2+44+2+44 = 176 + 6 */
    title = 'Letter Gothic, 4 columns of 44 chars, 6 char alley.'
    font  = ESC'(s0p24h6v0s6T'
    sep   = 'º '
    cross = 'ù-'
    width = 44; columns = 4
oddleftborder    = 10                /* Default oddside left margin */
    end
  when width <= 60 then do    /* 24cpi 60+2+60+2+60 = 184 */
    title = 'Letter Gothic, 3 columns of 60 chars, 3 char alley.'
    font  = ESC'(s0p24h6v0s6T'
    sep   = 'º '
    cross = 'ù-'
    width = 60; columns = 3
oddleftborder    = 8                /* Default oddside left margin */
    end
  when width <= 79 then do    /* 20cpi 79+2+79 = 160 */
    title = 'Courier, 2 columns of 79 chars, 2 char alley.'
    font  = ESC'(s0p20h6v0s3T'
    sep   = 'º '
    cross = 'ù-'
    width = 79; columns = 2
oddleftborder    = 0                /* Default oddside left margin */
    end
  when width = 80 then do    /* 20cpi 80+0+80 = 160 */
    title = 'Courier, 2 columns of 80 chars, 0 char space! ----> VIEL ZU ENG !!!'
    font  = ESC'(s0p20h6v0s3T'
    sep   = ''
    cross = ''
    width = 80; columns = 2
oddleftborder    = 0                /* Default oddside left margin - out of space ... */
    end
  otherwise do            /* 24cpi 89+4+89 = 182 */
    title = 'Letter Gothic, 2 columns of 89 chars, 3 char alley.'
    font  = ESC'(s0p24h6v0s6T'
    sep   = ' º  '
    cross = '-ù--'
    width = 89; columns = 2
oddleftborder    = 10                /* Default oddside left margin */
    end
  end
say title                    /* Let user know what has been selected */

sep1 = ''; sep2 = ''                /* Build the horizontal dividing line */
do column = 1 to columns-1
  sep1 = sep1 || copies(' ',width) || sep
  sep2 = sep2 || copies('-',width) || cross    /* Dashes and plus signs */
  end
sep2 = sep2 || copies('-',width)        /* 'XYZABCDEF' */

call writech('out',isoA4||ESC'&k2G'ESC'&s1C'ESC'&k6W'draft)    /* LF=CR+LF, no linewrap, textscale mode, draft ? */
call writech('out',ESC'&l12d126p0L'font||ESC'&l0F'psize)    /* 12 LPI, no perforation skip, bottom 1 inch */
if twopage then call close('out')

/* Process the single input file */

leftborder = copies(' ',oddleftborder)
prevline = ''
do until eof('in')
  paper = paper + 1                /* the sheet of paper to print */
  if twopage then do
    if paper//2 then leftborder = copies(' ',oddleftborder)
    else leftborder = copies(' ',evenleftborder)
    call open('out',basename||paper,'W')
    end
  LINES. = copies(' ',width)        /* Fill array with blanks */
  title = infile', page' paper', printed' date('weekday')',' ,
    date('normal') time('normal')
  say title                /* Show progress on the console */
  do page = 0 to (columns*2)-1        /* Top row, bottom row, N columns */
    do pageline = 1 to localpagesize
      line = (page*localpagesize)+pageline
      if length(prevline) > 0
        then temp = prevline        /* If previous char was a formfeed */
    else temp = translate(readln('in'),outputtable,inputtable)    /* Else read line from input file */
      prevline = ''
      i = index(temp,FF)        /* Look for formfeeds */
      select
    when i = 0 then nop        /* Nothing special if no formfeed */
    when i = 1 & pageline = 1 then ,
      temp = substr(temp,2)        /* Ignore FF if at top of page */
    when i = 1 & length(temp) = 1 then ,
      leave pageline        /* FF+LF = end of current page */
    when i = 1 then do        /* FF+TEXT+LF */
      prevline = substr(temp,2)    /* The TEXT goes on next page */
      leave pageline        /* Finished with current page */
      end
    otherwise do            /* TEXT+FF+LF or TEXT+FF+TEXT+LF */
      prevline = substr(temp,i)    /* Remember FF and possible text */
      temp = left(temp,i-1)        /* Process text that's before the FF */
      end
    end
      i = index(temp,HT)        /* Look for tabs */
      do while i > 0
        blanks = 8 - ( (i-1) // 8)    /* Replace tab with this many blanks */
        if i = 1 then              temp = copies(' ',blanks)||substr(temp,i+1)
      else temp = substr(temp,1,i-1)||copies(' ',blanks)||substr(temp,i+1)
        i = index(temp,HT)        /* Check multiple tabs on a line */
        end
      temp=strip(temp,'T')        /* Remove trailing blanks */

      bswidth=0                /* add 2 chars for each backspace */
      bsindex=0
      do forever
        bsindex=index(temp,'08'x,bsindex+1)
        if bsindex=0 then leave        /* Done */
        if bsindex>width+bswidth then leave    /* BS not in current line */
        bswidth=bswidth+2
      end

      LINES.line = left(temp,width+bswidth,' ')    /* Truncate, or pad with blanks */
      if substr(temp,width+1+bswidth)=='' then prevline=''
      else prevline='-->> 'substr(temp,width+1+bswidth)    /* The rest of the processed line or empty */
      end
    end

  /* Now that a paperful of data has been read, print it out. */

  call writeln('out',leftborder||center(title,width*columns+(columns-1)*length(sep)))
  call writeln('out','')
  do row = 0 to 1            /* Top half of page, then bottom half */
    do pageline = 1 to localpagesize
      temp = ''
      do column = 1 to columns
        line = (row*localpagesize*columns) + (column-1)*localpagesize + pageline
        temp = temp||LINES.line
    if column < columns then temp = temp||sep
    end
      if pageline = localpagesize & row = 1
      then call writech('out',leftborder||temp||CR||FF)    /* Formfeed at end of page */
      else call writech('out',leftborder||temp||LF)    /* Linefeed for all others */
      end    /* next pageline */
    if row = 0 then call writech('out',leftborder||sep1||LF||leftborder||sep2||LF||leftborder||sep1||LF) /* Dashes */
    end        /* next row (now do bottom half of page) */
  if twopage then call close('out')
  end        /* until EOF */

call close('in')

if twopage then do
                        /* Now copy the pages to the printer */

                        /* print p2 p4 <ff> <reinsert> p5 p3 p1 */
  numerror=0
  evenskip=paper//2
  call open('out','par:4.prt','W')
  call copyfile(0)                /* Copy the printer prologue */

  if paper~=1 then do                /* No need to print the next line :-) */
    do i = 2 to paper-evenskip by 2        /* Print the even pages */
       call copyfile(i)
       end
    if evenskip then call writech('out',FF)    /* Skip the empty last evenside page ? */

    say 'Please reinsert the output - page 2 on bottom blank side down'
    pull temp

    end

  if evenskip then paper1=paper            /* BUGFIX, again, oct 7 1992 */
  else paper1=paper-1
  do i = paper1 to 1 by -2            /* Print odd pages reversed */
    call copyfile(i)
    end

  if numerror=0 then do page=0 to paper        /* If there were no errors - erase temp files */
    call delete(basename||page)
    end
  else say 'There were errors: the pages are 'basename'<count> [0 is the printer init]'
  end

call close('out')                /* One-sided: we already printed, so skip the above */

'initprinter'                    /* Reinitialize the printer */
exit 0


/********************************************/  /* Subroutines */

copyfile: procedure expose basename numerror    /* Print a page */
  arg page
  if ~open('in',basename||page,'R')
    then do
      call writech('out',FF)            /* Skip the page */
      say 'ERROR: Could not print page 'i' - skipping'
      numerror = 1
      end
    else do
      do forever                /* Copy the page */
        temp=readch('in',20000)
        call writech('out',temp)
        if temp=='' then leave
        end
      call close('in')
      end
return

/* End of s:print4 */
/*
--
Joe Smith [phone]     BTNA GNS Major Programs, TYMNET Global Network
<[e-mail]>     P.O. Box 49019, MS-C51, San Jose, CA 95161-9019
CA license plate: "POPJ P,"    Married to the LB, Quantum Leap's #1 net.fan
PDP-10, 36-bits forever!    Humorous disclaimer: "My Amiga 3000 speaks for me."
*/